home *** CD-ROM | disk | FTP | other *** search
/ Over 1,000 Windows 95 Programs / Over 1000 Windows 95 Programs (Microforum) (Disc 1).iso / 1132 / slug.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-04-17  |  35.4 KB  |  1,139 lines
  1. {$F+}
  2.                  program neural_application2;
  3.  
  4. uses objects,owindows,odialogs,strings,win31,windos, wintypes,winprocs,
  5.      ostddlgs,bwcc,bpnet, nnunit, dyna2,wintools,cfmtools;
  6.  
  7. {$I SLUG.inc}
  8. {$R SLUG}
  9.  
  10. type
  11.  
  12.    nninitdata = record
  13.            inputsize            : longint;
  14.            outputsize           : longint;
  15.            hiddensize           : longint;
  16.    end;
  17.  
  18.    NNLearnparams  = record
  19.            Lcoeff         : double;
  20.            momentum       : double;
  21.            Kmod           : double;
  22.            Maxerr         : double;
  23.            Maxiter        : longint;
  24.    end;
  25.  
  26.    TrainStepRec = record
  27.            DMdesired     : pdynamat;
  28.            DMinput       : pdynamat;
  29.            DVerror       : pdynavec;
  30.    end;
  31.  
  32.  
  33.  
  34.    pannpgm  = ^ANNpgm;
  35. {----------------------------}
  36.    ANNpgm   = object(tapplication)
  37. {----------------------------}
  38.  
  39.       procedure Initmainwindow; virtual;
  40.  
  41.    end;
  42.  
  43.  
  44.     pNNwindow   = ^NNwindow;
  45. {----------------------------}
  46.     NNWindow    = object(tdlgwindow)
  47. {----------------------------}
  48.       net                   : psimplebpnet;
  49.       inname                : array[0..fspathname] of char;
  50.       outname               : array[0..fspathname] of char; {these contain a network on stream}
  51.       datainname            : array[0..fspathname] of char;
  52.       logname               : array[0..fspathname] of char; {these contain network data}
  53.       infile,
  54.       outfile               : pdosstream; {streams for network}
  55.       datainfile,
  56.       logfile               : text;
  57.       initbuffer            : nninitdata; {user data}
  58.       learnbuffer           : NNlearnparams;
  59.       datainopen            : boolean;  {are the data files open? }
  60.       logopen               : boolean;
  61.       netok,dataok,logok    : boolean;  {are these specified ?}
  62.       modified              : boolean;  {refers to network spec file}
  63.       paused                : boolean;
  64.       running               : boolean;
  65.       training              : boolean;
  66.       stopped               : boolean;
  67.       logappend             : boolean; {Logfile Append check box}
  68.       edmomentum,edlearn,                 {edit controls in the main dialog box}
  69.       edkmod,edmaxerr,
  70.       infolearn,
  71.       infomomentum          : pfloatedit;  {don't need these in BP7...}
  72.       edmaxiter             : pnumedit;
  73.       edinfocount           : pnumedit;
  74.       edinfoerror           : pfloatedit;
  75.       eddatafile,
  76.       edlogfile             : pedit;
  77.       chlogappend           : pcheckbox;
  78.  
  79.  
  80.       constructor init(aparent : pwindowsobject; atitle  : pchar);
  81.       destructor done; virtual;
  82.       function  canclose : boolean; virtual;
  83.       function  getclassname : pchar ;virtual;
  84.       procedure getwindowclass(var awndclass : twndclass); virtual;
  85.       procedure CMnewfile(var mess : tmessage); virtual cm_first +cm_filenew;
  86.       procedure CMopenfile(var mess : tmessage); virtual cm_first +cm_fileopen;
  87.       procedure CMsavefile(var mess : tmessage); virtual cm_first +cm_filesave;
  88.       procedure CMsaveasfile(var mess : tmessage); virtual cm_first +cm_filesaveas;
  89.       procedure CMEXit(var mess : tmessage); virtual cm_first +cm_exit;
  90.       procedure CMbuildnet(var mess : tmessage); virtual cm_first + cm_netedit;
  91.       procedure CMdatain(var mess : tmessage); virtual cm_first +cm_datain;
  92.       procedure CMdataout(var mess : tmessage); virtual cm_first +cm_dataout;
  93.       procedure CMtrain(var mess : tmessage); virtual cm_first +cm_train;
  94.       procedure CMtrainparams(var mess: tmessage); virtual cm_first+ cm_trainedit;
  95.       procedure CMrun(var mess : tmessage); virtual cm_first +cm_run;
  96.       procedure CMAbout(var mess : tmessage); virtual cm_first +cm_about;
  97.       procedure CMdisplay(var mess : tmessage); virtual cm_first +cm_display;
  98.       procedure BNpausenet(var mess : tmessage); virtual id_first+ id_pause;
  99.       procedure BNstopnet(var mess : tmessage); virtual id_first+ id_iterstop;
  100.       procedure BNsavenet(var mess : tmessage); virtual id_first+ id_savenet;
  101.       procedure BNreadnet(var mess : tmessage); virtual id_first+ id_readnet;
  102.       procedure BNshakenet(var mess : tmessage); virtual id_first+ id_shake;
  103.       procedure BNtrain(var mess : tmessage); virtual id_first+ id_train;
  104.  
  105.       procedure BNdataopen(var mess : tmessage);virtual id_first+id_dataopen;
  106.       procedure BNdataclose(var mess : tmessage); virtual id_first+id_dataclose;
  107.       procedure BNlogopen(var mess : tmessage); virtual id_first+id_logopen;
  108.       procedure BNlogclose(var mess : tmessage); virtual id_first+id_logclose;
  109.       procedure BNtrainparams(var mess : tmessage); virtual id_first+id_trainparams;
  110.       procedure trainsession;
  111.       function  trainepoch(var data : trainsteprec; count: word) : double;
  112.       procedure setupnetparams;
  113.       procedure showtrainparams;
  114.       procedure shownetparams;
  115.       procedure showicon(state : word);
  116.       function  closelogfile    : boolean;
  117.       function  closedatafile   : boolean;
  118.       function  killnet         : boolean;
  119.       procedure report(rep :pchar);          
  120.  
  121.     end;
  122.  
  123.  
  124.     pSpecdialog = ^Specdialog;
  125. {----------------------------}
  126.     Specdialog  = object(tdialog)
  127. {----------------------------}
  128.        procedure zerocounts(var mess : tmessage); virtual
  129.                                                  id_first + id_netspecclear;
  130.     end;
  131.  
  132.  
  133.  
  134.  
  135.    {--------------------- NNWINDOW PROCEDURES --------------------------}
  136.  
  137.  
  138.  
  139. {----------------------------}
  140. constructor nnwindow.init(aparent : pwindowsobject;
  141.                           atitle  : pchar);
  142. {----------------------------}
  143. begin
  144.      tdlgwindow.init(aparent,atitle);
  145.      ismodal  := false;
  146.  
  147.      strcopy(outname,'');
  148.      strcopy(inname,'*.ann');
  149.      strcopy(datainname,'');
  150.      strcopy(logname,'');
  151.      infile         := nil;
  152.      outfile        := nil;
  153.      net            := nil;
  154.      modified   := false;
  155.      paused     := false;
  156.      running    := false;
  157.      stopped    := false;
  158.      training   := false;
  159.      datainopen := false;
  160.      logopen    := false;
  161.      logok      := false;
  162.      dataok     := false;
  163.      netok      := false;
  164.      logappend  := false;
  165.  
  166.  
  167.      with initbuffer do
  168.         begin
  169.         inputsize     := 2;
  170.         outputsize    := 1;
  171.         hiddensize    := 2;
  172.         end;
  173.      with learnbuffer do
  174.         begin
  175.         lcoeff      := 0.5;
  176.         momentum    := 0.8;
  177.         kmod        := 0;
  178.         maxerr      := 0.1;
  179.         maxiter     := 20000;
  180.         end;
  181.  
  182.                 { Initialize the edit controls }
  183.      new(edmomentum,initresource(@self,ed_usermomen,3,0,999));
  184.      new(edlearn,initresource(@self,ed_userlearn,3,0,999));
  185.      new(edkmod,initresource(@self,ed_userkmod,3,0,999));
  186.      new(edmaxerr,initresource(@self,ed_usermaxerr,3,0,999));
  187.      new(edmaxiter,initresource(@self,ed_usermaxiter,3,0,999));
  188.      new(eddatafile,initresource(@self,ed_userdatafile,20));
  189.      new(edlogfile,initresource(@self,ed_userlogfile,20));
  190.  
  191.      new(edinfocount,initresource(@self,ed_infocount,3,0,99999));
  192.      new(edinfoerror,initresource(@self,ed_infoerror,6,0,999));
  193.      new(infolearn,initresource(@self,ed_infolearn,6,0,999));
  194.      new(infomomentum,initresource(@self,ed_infomomen,6,0,999));
  195.      new(chlogappend,initresource(@self,id_append));
  196.  
  197.      showicon(sw_hide);
  198. end;
  199.  
  200. {----------------------------}
  201. destructor nnwindow.done;
  202. {----------------------------}
  203. begin
  204.      if net <> nil then dispose(net,done);
  205.      dispose(edmomentum, done);
  206.      dispose(edlearn,done);
  207.      dispose(edkmod,done);
  208.      dispose(edmaxerr,done);
  209.      dispose(edmaxiter,done);
  210.      dispose(eddatafile,done);
  211.      dispose(edlogfile,done);
  212.  
  213.      dispose(edinfocount,done);
  214.      dispose(edinfoerror,done);
  215.      dispose(infolearn,done);
  216.      dispose(infomomentum,done);
  217.      dispose(chlogappend,done);
  218.  
  219.      if datainopen then close(datainfile);
  220.      if logopen then close(logfile);
  221.  
  222.      tdlgwindow.done;
  223. end;
  224.  
  225.  
  226. {----------------------------}
  227. function nnwindow.getclassname : pchar;
  228. {----------------------------}
  229. begin
  230.      getclassname := 'neuralnetwindow';
  231. end;
  232.  
  233. {----------------------------}
  234. procedure nnwindow.getwindowclass(var awndclass : twndclass);
  235. {----------------------------}
  236. begin
  237.      tdlgwindow.getwindowclass(awndclass);
  238.      awndclass.hicon := loadicon(hinstance,'networkicon');
  239.      awndclass.lpszmenuname    := 'themenu';
  240.      Awndclass.hbrbackground := getstockobject(null_brush);
  241.         {Remember to specify the menu in the resource file !}
  242. end;
  243.  
  244.  
  245. {----------------------------}
  246. function nnwindow.canclose : boolean;
  247. {----------------------------}
  248. var
  249.    reply : integer;
  250.    mess  : tmessage;
  251. begin
  252.     canclose := true;
  253.     if training or running then BNstopnet(mess);
  254.     if netok and modified then
  255.         begin
  256.         reply := messagebox(hwindow,'Lose your changes ?','Net has changed...',
  257.                         mb_yesno or mb_iconquestion);
  258.         if reply = idno then
  259.            canclose := false
  260.         else
  261.             begin
  262.             canclose := true;
  263.             if net <> nil then
  264.                begin
  265.                dispose(net,done);
  266.                net := nil;
  267.                netok := false;
  268.                showicon(sw_hide);
  269.                end;
  270.             end;
  271.         end;
  272.  
  273. end;
  274.  
  275. {----------------------------}
  276. procedure nnwindow.cmExit(var mess: tmessage);
  277. {----------------------------}
  278. begin
  279.      if not (training or running) then tdlgwindow.CmExit(mess);
  280. end;
  281.  
  282. {----------------------------}
  283. function  nnwindow.closelogfile    : boolean;
  284. {----------------------------}
  285. begin
  286.      if logopen then close(logfile);
  287.      logopen := false;
  288.      logok   := false;
  289.      setdlgitemtext(hwindow,ed_userlogfile,'');
  290.      closelogfile := true;
  291. end;
  292.  
  293. {----------------------------}
  294. function  nnwindow.closedatafile   : boolean;
  295. {----------------------------}
  296. begin
  297.      if datainopen then close(datainfile);
  298.      datainopen := false;
  299.      dataok   := false;
  300.      setdlgitemtext(hwindow,ed_userdatafile,'');
  301.      closedatafile := true;
  302. end;
  303.  
  304. {----------------------------}
  305. function  nnwindow.killnet         : boolean;
  306. {----------------------------}
  307.                               { If a modified net exists, asks
  308.                                  before disposing of it.
  309.                                  Returns true if the net is disposed.}
  310. var
  311.    ans          : word;
  312.    mess         : Tmessage;
  313.    cankill      : boolean;
  314. begin
  315.      cankill := false;
  316.      if (net = nil) then
  317.          begin
  318.          killnet := true;
  319.          netok := false;
  320.          exit;
  321.          end;
  322.  
  323.      if not modified then cankill := true;
  324.      if modified then   
  325.           begin
  326.           ans := messagebox(hwindow,'Do you want to save it ?',
  327.                               'This net has changed',
  328.                               mb_yesnocancel or mb_iconhand);
  329.           case ans of
  330.             id_cancel : cankill := false;
  331.             id_yes    :
  332.                        begin
  333.                        CMsaveasfile(mess);
  334.                        cankill := true;
  335.                        end;
  336.             id_no     : cankill := true;
  337.             end;
  338.           end;
  339.  
  340.      if cankill then
  341.      begin
  342.      dispose(net,done);
  343.      net := nil;
  344.      netok := false;
  345.      showicon(sw_hide);
  346.      end;
  347.  
  348.      killnet := cankill;
  349. end;
  350.  
  351. {----------------------------}
  352. procedure nnwindow.CMnewfile(var mess : tmessage);
  353. {----------------------------}
  354. var
  355.    ans  : integer;
  356. begin
  357.                         {Throw the old network out and build a new one}
  358.      if not (running or training) then
  359.      if killnet then
  360.         begin
  361.         setdlgitemtext(hwindow,ed_netname,'');
  362.         strcopy(outname,'');
  363.         strcopy(inname,'');
  364.         if datainopen then closedatafile;
  365.         CMbuildnet(mess);
  366.         if net <> nil then
  367.            begin
  368.            netok := true;
  369.            showicon(sw_show);
  370.            shownetparams;
  371.            end
  372.         else
  373.            begin
  374.            netok := false;
  375.            showicon(sw_hide);
  376.            report('Error creating network - report to author !');
  377.            end;
  378.         end;
  379. end;
  380.  
  381. {----------------------------}
  382. procedure nnwindow.CMopenfile(var mess : tmessage);
  383. {----------------------------}
  384.                                 {Throw out old net and read a new one}
  385. var
  386.    result,save       : integer;
  387. begin
  388.      if running or training then exit;
  389.                           { else, net is now nil.
  390.                             If If new name chosen, get it from stream. }
  391.      strcopy(inname,'*.ann');
  392.      if application^.execdialog(new(pfiledialog,init(@self,
  393.                                     pchar(sd_bcfileopen), inname))) = id_ok
  394.      then
  395.        begin
  396.        if not killnet then exit;
  397.        strcopy(outname,inname);
  398.        new(infile,init(inname,stopenread));
  399.        if (infile^.status <> stOK) then
  400.              begin
  401.              say('Could not open file ! ');
  402.              if infile <> nil then dispose(infile,done);
  403.              exit;
  404.              end; 
  405.        net := psimplebpnet(infile^.get);
  406.        dispose(infile,done);
  407.  
  408.        if (net <> nil) then    { net OK}
  409.          begin
  410.          netok := true;
  411.          showicon(sw_show);
  412.          shownetparams;
  413.          setdlgitemtext(hwindow,ed_netname,inname);
  414.          if datainopen then closedatafile;
  415.          with initbuffer do
  416.             begin
  417.             inputsize    := net^.inputfield^.count;
  418.             outputsize   := net^.outputfield^.count;
  419.             hiddensize   := net^.hiddenfield^.count;
  420.             end;
  421.          with learnbuffer do
  422.             begin
  423.             lcoeff      := net^.learn;
  424.             momentum    := net^.momen;
  425.             end;
  426.          end
  427.        else                    { Net not OK} 
  428.          begin
  429.          say('No network present !');
  430.          report('Error');
  431.          showicon(sw_hide);
  432.          strcopy(inname,'*.ann');
  433.          strcopy(outname,'');
  434.          setdlgitemtext(hwindow,ed_netname,'');
  435.          netok := false;
  436.          end;  
  437.        end;
  438.      
  439.  
  440. end;
  441.  
  442. {----------------------------}
  443. procedure nnwindow.CMsaveasfile(var mess : tmessage);
  444. {----------------------------}
  445.                               { Overwrites without asking !
  446.                               }
  447. begin
  448.      if (strlen(outname) = 0) then
  449.        strcopy(outname,'*.ann')
  450.      else
  451.        strcopy(outname,inname);
  452.  
  453.      if application^.execdialog(new(pfiledialog,init(@self,
  454.                      pchar(sd_bcFileSave), outname))) = id_ok
  455.      then
  456.        begin
  457.        setdlgitemtext(hwindow,ed_netname,outname);
  458.        modified := false;
  459.        new(outfile,init(outname,stcreate));
  460.        if outfile^.status <> stOK then
  461.           begin
  462.           say('Could not create file ! ');
  463.           exit
  464.           end; 
  465.        outfile^.put(net);
  466.        dispose(outfile,done);
  467.        outfile := nil;
  468.        report('Net saved');
  469.        end;
  470. {$ifdef debug}
  471.      messagebox(hwindow,outname,'File saved as :',mb_ok);
  472. {$endif}
  473. end;
  474.  
  475. {----------------------------}
  476. procedure nnwindow.CMsavefile(var mess : tmessage);
  477. {----------------------------}
  478.  
  479.                                 {Simply save}
  480. begin
  481.      if (net <>nil) and (strlen(outname)<> 0)  then
  482.        begin
  483.        new(outfile,init(outname,stcreate));
  484.        if outfile^.status <> stOK then
  485.           begin
  486.           say('Could not open file ! ');
  487.           Report('Error during stream access');
  488.           exit
  489.           end; 
  490.        outfile^.put(net);
  491.        dispose(outfile,done);
  492.        modified := false;
  493.        report('Net written');
  494.        end
  495.      else
  496.        if (net <>nil) then CMsaveasfile(mess);
  497.  
  498. {$ifdef debug}
  499.      messagebox(hwindow,outname,'Written to :',mb_ok);
  500. {$endif}
  501. end;
  502.  
  503. {-----------------------------------}
  504. procedure nnwindow.CMbuildnet(var mess : tmessage);
  505. {-----------------------------------}
  506. var
  507.    edit1, edit2, edit3, edit4    : pnumedit; {numeric edit boxes}
  508.    dlg                           : pspecdialog;
  509.    result,discard,i              : integer;
  510.  
  511. procedure builddialog;
  512. begin
  513.       new(dlg,init(@self,'netspec1'));   {init the dialog }
  514.       dlg^.transferbuffer := @initbuffer;
  515.                                          {and the controls}
  516.       new(edit1,initresource(dlg,id_netspecin,3,1,999));
  517.       new(edit2,initresource(dlg,id_netspecout,3,1,999));
  518.       new(edit3,initresource(dlg,id_netspechidden,3,1,999));
  519.                                               {execute the dialog}
  520.       result := application^.execdialog(dlg);
  521.       if result <= 0 then say('Could not open the dialog');
  522. end;
  523.  
  524. begin
  525.       if killnet then
  526.          begin
  527.          if datainopen then closedatafile;
  528.          builddialog;
  529.          with initbuffer do
  530.              begin
  531.              new(net,init(initbuffer.inputsize,
  532.                           initbuffer.hiddensize,
  533.                           initbuffer.outputsize,0.5,0.5));
  534.              if net <> nil then
  535.                begin
  536.                net^.shake(1.0);
  537. {               for i:= 1 to net^.hiddenfield^.count do
  538.                   pneuron(net^.hiddenfield^.at(i-1))^.setscale(1.7);
  539. }               end;
  540.  
  541.              end;
  542.          showicon(sw_show);
  543.          modified := false;
  544.          netok := true;
  545.          report('New network created');
  546.          end;
  547.  
  548. end;
  549.  
  550. {--------------------------}
  551. procedure nnwindow.CMdatain(var mess : tmessage);
  552. {--------------------------}
  553. begin
  554.  
  555.      if datainopen then closedatafile;
  556.      strcopy(datainname,'*.dat');
  557.      if application^.execdialog(new(pfiledialog,init(@self,
  558.                      pchar(sd_bcfileopen), datainname))) = id_ok
  559.      then
  560.         begin
  561.         setdlgitemtext(hwindow,ed_userdatafile,datainname);
  562.         dataok := true;
  563.         report('Datafile specified');
  564.         end
  565.      else
  566.          begin
  567.          strcopy(datainname,'');
  568.          dataok := false;
  569.          report('Datafile needs to be specified');
  570.          end;
  571. end;
  572.  
  573.  
  574. {--------------------------}
  575. procedure nnwindow.CMdataout(var mess : tmessage);
  576. {--------------------------}
  577. begin
  578.     if logopen
  579.     then
  580.        if messagebox(hwindow,'Do you want to close it ?','Logfile is open !',
  581.                   mb_yesno or mb_iconhand) = id_no
  582.        then exit
  583.        else
  584.             begin
  585.             closelogfile;
  586.             logopen := false;
  587.             logok := false;
  588.             report('Logfile closed');
  589.             end;
  590.  
  591.     strcopy(logname,'*.log');
  592.     if application^.execdialog(new(pfiledialog,init(@self,
  593.                 pchar(sd_bcfileopen), logname))) = id_ok
  594.     then
  595.           begin
  596.           logok := true;
  597.           logopen := false;
  598.           setdlgitemtext(hwindow,ed_userlogfile,logname);
  599.           if chlogappend^.getcheck = bf_checked then logappend := true
  600.              else logappend := false;
  601.           Report('Logfile specified');
  602.           end;
  603.  
  604. end;
  605.  
  606.  
  607. {--------------------------}
  608. procedure nnwindow.CMtrainparams(var mess: tmessage);
  609. {--------------------------}
  610. var
  611.    edit1, edit2, edit3, edit4 : pfloatedit; {numeric edit boxes}
  612.    edit5                      : pnumedit;
  613.    dlg                        : pspecdialog;
  614.    result,discard             : integer;
  615.  
  616. begin
  617.       new(dlg,init(@self,'trainparam'));   {init the dialog }
  618.       dlg^.transferbuffer := @learnbuffer;
  619.                                          {and the controls}
  620.       new(edit1,initresource(dlg,ed_userlearn,10,0,100));
  621.       new(edit2,initresource(dlg,ed_usermomen,10,0,100));
  622.       new(edit3,initresource(dlg,ed_userkmod,10,0,100));
  623.       new(edit4,initresource(dlg,ed_usermaxerr,10,0,10));
  624.       new(edit5,initresource(dlg,ed_usermaxiter,6,0,100000));
  625.  
  626.                                               {execute the dialog}
  627.       result := application^.execdialog(dlg);
  628.       if result <= 0 then
  629.          begin
  630.          say('Insufficient memory');
  631.          exit;
  632.          end;
  633.  
  634.       if (net <> nil) and (result=id_ok) then
  635.          begin
  636.          with learnbuffer do
  637.             begin
  638.             net^.learn := learnbuffer.lcoeff;    { tell the net}
  639.             net^.momen := learnbuffer.momentum;
  640.                                                  {tell the user}
  641.             showtrainparams;
  642.             end;
  643.           end;
  644. end;
  645.  
  646. {--------------------------}
  647. procedure nnwindow.showtrainparams;
  648. {--------------------------}
  649.                             { Redisplays current learning params } 
  650. begin
  651.      if netok then
  652.          begin
  653.          edlearn^.transfer(@net^.learn,tf_setdata);
  654.          edmomentum^.transfer(@net^.momen,tf_setdata);
  655.          edkmod^.transfer(@learnbuffer.kmod,tf_setdata);
  656.          edmaxerr^.transfer(@learnbuffer.maxerr,tf_setdata);
  657.          setdlgitemint(hwindow,ed_usermaxiter,learnbuffer.maxiter,false);
  658.          infolearn^.transfer(@net^.learn,tf_setdata);
  659.          infomomentum^.transfer(@net^.momen,tf_setdata);
  660.          end;
  661. end;
  662.  
  663. {--------------------------}
  664. procedure nnwindow.shownetparams;
  665. {--------------------------}
  666. begin
  667.      if net <> nil then
  668.          begin
  669.          setdlgitemint(hwindow,id_incount,net^.inputfield^.count,false);
  670.          setdlgitemint(hwindow,id_hiddencount,net^.hiddenfield^.count,false);
  671.          setdlgitemint(hwindow,id_outcount,net^.outputfield^.count,false);
  672.          end;
  673. end;
  674.  
  675. {--------------------------}
  676. procedure nnwindow.CMtrain(var mess: tmessage);
  677. {--------------------------}
  678. begin
  679.      if ((dataok) and     { If all is set up...}
  680.         (logok) and
  681.         (net <> nil) and
  682.         not training )
  683.      then
  684.        begin
  685.        training := true;             {then open the files..}
  686.        paused := false;
  687.        stopped:= false;
  688.        if not datainopen then opentextfile(datainname,datainfile);
  689.                                      {check for append on logfile}
  690.  
  691.        if not logopen then
  692.           if not logappend then
  693.              createtextfile(logname,logfile)
  694.           else
  695.              appendtextfile(logname,logfile);
  696.  
  697.                                      {do some interface stuff}
  698.        logopen     := true;
  699.        datainopen  := true;
  700.        showwindow(getdlgitem(hwindow,id_readnet), sw_hide);
  701.        showwindow(getdlgitem(hwindow,id_dataopen), sw_hide);
  702.        showwindow(getdlgitem(hwindow,id_dataclose), sw_hide);
  703.        showwindow(getdlgitem(hwindow,id_logopen), sw_hide);
  704.        showwindow(getdlgitem(hwindow,id_logclose), sw_hide);
  705.        enablewindow(getdlgitem(hwindow,id_cancel),false);
  706.        enablemenuitem(getmenu(hwindow),cm_exit,mf_bycommand or mf_grayed);
  707.        enablemenuitem(getmenu(hwindow),cm_fileopen,mf_bycommand or mf_grayed);
  708.        enablemenuitem(getmenu(hwindow),cm_filenew,mf_bycommand or mf_grayed);
  709.        enablemenuitem(getmenu(hwindow),cm_netedit,mf_bycommand or mf_grayed);
  710.        drawmenubar(hwindow);
  711.        report('Training');
  712.  
  713.        trainsession;                  {and train}
  714.  
  715.        spacedline(logfile,'Final Weights');
  716.        printmattofile(logfile,net^.weights^);
  717.        spacedline(logfile,' ');
  718.        reset(datainfile);
  719.        paused := false;
  720.        training:= false;
  721.        showwindow(getdlgitem(hwindow,id_readnet), sw_show);
  722.        showwindow(getdlgitem(hwindow,id_dataopen), sw_show);
  723.        showwindow(getdlgitem(hwindow,id_dataclose), sw_show);
  724.        showwindow(getdlgitem(hwindow,id_logopen), sw_show);
  725.        showwindow(getdlgitem(hwindow,id_logclose), sw_show);
  726.        enablewindow(getdlgitem(hwindow,id_cancel),true);
  727.        enablemenuitem(getmenu(hwindow),cm_exit,mf_enabled or mf_bycommand);
  728.        enablemenuitem(getmenu(hwindow),cm_filenew,mf_bycommand or mf_enabled);
  729.        enablemenuitem(getmenu(hwindow),cm_fileopen,mf_bycommand or mf_enabled);
  730.        enablemenuitem(getmenu(hwindow),cm_netedit,mf_bycommand or mf_enabled);
  731.        drawmenubar(hwindow);
  732.        end;
  733.  
  734. end;
  735.  
  736. {--------------------------}
  737. procedure nnwindow.trainsession;
  738. {--------------------------}
  739. var
  740.    i,j                  : word;
  741.    count                : longint;
  742.    lines,linelength     : integer;
  743.    totalerror,lasterror : double;
  744.    Traindata            : Trainsteprec;
  745.    incount,outcount     : integer;
  746.    mess                 : tmsg;
  747.    dvin                 : pdynavec; { for net response after training}
  748.  
  749. begin
  750.      if net = nil then
  751.         BEGIN
  752.         messagebox(hwindow,'','No Network defined !',mb_ok);
  753.         exit;
  754.         END
  755.      else
  756.         modified := true;
  757.  
  758.                                 { Check out datafile }
  759.      readln(datainfile); readln(datainfile);
  760.      lines := countlines(datainfile);
  761.      readln(datainfile);readln(datainfile); {position correctly...}
  762.                                             {Data interpretation determined
  763.                                              by network structure}
  764.      outcount := net^.outputfield^.count;   
  765.      incount  := net^.inputfield^.count;
  766.      linelength:= incount + outcount;
  767.  
  768.                                 { Make datastructures}
  769.      with traindata do
  770.           begin
  771.           new(DMInput,init(lines,linelength));
  772.           new(DMdesired,init(lines,outcount));
  773.           new(DVerror,init(outcount,1));
  774.                                 { Get input data}
  775.           linestomat(datainfile,DMinput^);
  776.           writeln(logfile,'IO MATRIX');
  777.           printmattofile(logfile,DMinput^);
  778.           for i := 1 to lines do
  779.               for j := 1 to outcount do
  780.                  DMdesired^.put(i,j,DMinput^.get(i,incount+j));
  781.           writeln(logfile,'DESIRED MATRIX');
  782.           printmattofile(logfile,DMdesired^);
  783.  
  784.           for i := 1 to outcount do DMinput^.deletecol(incount+i);
  785.           writeln(logfile,'INPUT MATRIX');
  786.           printmattofile(logfile,DMinput^);
  787.           end;
  788.  
  789.      setupnetparams;
  790.      showtrainparams;
  791.                     { Start the training...}
  792.  
  793.      count      := 0;
  794.      totalerror :=9999;
  795.      repeat
  796.          yield(mess);
  797.          edinfocount^.transfer(@count,tf_setdata);
  798.          edinfoerror^.transfer(@totalerror,tf_setdata);
  799.          if stopped then
  800.             begin
  801.             report('Stopped');
  802.             exit;
  803.             end;
  804.          if not paused then
  805.             begin   
  806.             count := count +1;
  807.             totalerror := TrainEpoch(traindata,lines); {present all data once}
  808.             edinfocount^.transfer(@count,tf_setdata);
  809.             edinfoerror^.transfer(@totalerror,tf_setdata);
  810.             if (count mod 10) = 0 then
  811.                begin
  812.                infolearn^.transfer(@net^.learn,tf_setdata);
  813.                infomomentum^.transfer(@net^.momen,tf_setdata);
  814.                end;
  815.             if (count mod 10)=0 then
  816.                 writeln(logfile,'Event # ',count,totalerror:12:6);
  817.             end;
  818.  
  819.      until (totalerror < learnbuffer.maxerr) or
  820.           (count > learnbuffer.maxiter);
  821.  
  822.                               {finished Training...}
  823.  
  824.      report('Trained !');
  825.      with traindata do
  826.        begin
  827.        spacedline(logfile,'Network response: ');
  828.        for j := 1 to lines do
  829.           begin
  830.           dminput^.getrow(j,dvin);
  831.           net^.feedforward(dvin);
  832.           write(logfile,' inputvec  :');
  833.           printvec(logfile,80,dvin^);
  834.           write(logfile,' response : ');
  835.           for i := 1 to net^.outputfield^.count do
  836.              write(logfile,pneuron(net^.outputfield^.at(i-1))^.output:8:3);
  837.           writeln(logfile);
  838.           end;
  839.        flush(logfile);
  840.  
  841.        dispose(dmdesired,done);
  842.        dispose(dminput,done);
  843.        dispose(dverror,done);
  844.        end;
  845.  
  846. end;
  847.  
  848.  
  849. {----------------------------}
  850.  function nnwindow.trainepoch(var data : trainsteprec; count: word) : double;
  851. {----------------------------}
  852. var                           { Presents count I/O pairs once}
  853.    lasterror, totalerror    : double;
  854.    dvin,dvdesired           : pdynavec;
  855.    thisone                  : pneuron;
  856.    i,j                        : integer;
  857.    mess                       : tmsg;
  858. begin
  859.        if paused then exit;
  860.  
  861.        for j := 1 to count do { For each training datum...}
  862.  
  863.           begin
  864.           inc(count);
  865.           data.DMdesired^.getrow(j,dvdesired); {get data}
  866.           data.DMinput^.getrow(j,dvin);
  867.           net^.feedforward(dvin);              { Feed it forward}
  868.            
  869.                                 {make error vector}
  870.           for i := 1 to net^.outputfield^.count do  {...for each output neuron}
  871.               begin
  872.               yield(mess);
  873.               thisone := net^.outputfield^.at(i-1);
  874.               lasterror := (dvdesired^.get(i) - thisone^.output);
  875.               totalerror := totalerror + abs(lasterror);
  876.               data.dverror^.put(i, lasterror);
  877.               end;              { feed error back}
  878.  
  879.           net^.backpropall(data.dverror);
  880.           yield(mess);
  881.           net^.getdeltaweights(net^.learn,net^.momen);
  882.           yield(mess);
  883.           net^.adjustweights;
  884.           yield(mess);
  885.           end;
  886.  
  887.        trainepoch := totalerror;
  888.  
  889. end;
  890.  
  891.  
  892. {----------------------------}
  893. procedure nnwindow.setupnetparams;
  894. {----------------------------}
  895.                               { Get data from buffers to the existing net}
  896. begin
  897.                                 { Setup Backpropnet}
  898.      net^.learn := learnbuffer.lcoeff;
  899.      net^.momen := learnbuffer.momentum;
  900.  
  901.      net^.setfieldsignal(net^.inputfield,linear);
  902.      net^.setfieldsignal(net^.hiddenfield,sigmoid);
  903.      net^.setfieldsignal(net^.outputfield,linear);
  904. end;
  905.  
  906.  
  907. {--------------------------}
  908. procedure nnwindow.CMrun(var mess : tmessage);
  909. {--------------------------}
  910. var
  911.    DMInput      : pdynamat;
  912.    DVIn         : pdynavec;
  913.    lines,i,j     : integer;
  914. begin
  915.    if (net <> nil) and (dataok) then
  916.    begin
  917.      if not datainopen then
  918.        if opentextfile(datainname,datainfile) <> 0 then exit;
  919.      if not logopen then
  920.        if createtextfile(logname,logfile) <> 0 then exit;
  921.      logopen     := true;
  922.      datainopen  := true;
  923.  
  924.      reset(datainfile);
  925.      readln(datainfile); readln(datainfile);
  926.      lines := countlines(datainfile);
  927.      readln(datainfile);readln(datainfile); {position correctly...}
  928.      new(dminput,init(lines,net^.inputfield^.count));
  929.  
  930.                                 { Get input data}
  931.      linestomat(datainfile,DMinput^);
  932.      writeln(logfile,'DATA MATRIX');
  933.           printmattofile(logfile,DMinput^);
  934.  
  935.        for j := 1 to lines do
  936.           begin
  937.           dminput^.getrow(j,dvin);
  938.           net^.feedforward(dvin);
  939.           setdlgitemint(hwindow,ed_infocount,j,false);
  940.           printvec(logfile,80,dvin^);
  941.           for i := 1 to net^.outputfield^.count do
  942.              write(logfile,pneuron(net^.outputfield^.at(i-1))^.output:8:3);
  943.           writeln(logfile);
  944.           end;
  945.        flush(logfile);
  946.  
  947.        dispose(dminput,done);
  948.        report('Run Complete');
  949.      end;
  950. end;
  951. {--------------------------}
  952. procedure nnwindow.CMdisplay(var mess : tmessage);
  953. {--------------------------}
  954. begin
  955.      messagebox(hwindow,'Not implemented','Bad Luck',mb_OK);
  956. end;
  957.  
  958. {----------------------------}
  959. procedure nnwindow.BNpausenet(var mess : tmessage);
  960. {----------------------------}
  961.                               { Sets flag to indicate pause/resume to running net,
  962.                                 and toggles the button text.
  963.                               }
  964. begin
  965.   if (net <> nil) and (running or training) then
  966.      if not paused  then
  967.         begin
  968.         paused := true;
  969.         setdlgitemtext(hwindow,id_pause,'Resume');
  970.         enablewindow(getdlgitem(hwindow,id_train),false);
  971.         enablewindow(getdlgitem(hwindow,id_iterstop),false);
  972.         enablemenuitem(getmenu(hwindow),cm_train,mf_bycommand or mf_grayed);
  973.         drawmenubar(hwindow);
  974.         report('Paused');
  975.         if datainopen then spacedline(logfile,'----- Paused ------');
  976.         end
  977.      else
  978.         begin
  979.         paused := false;
  980.         setdlgitemtext(hwindow,id_pause,'Pause');
  981.         enablewindow(getdlgitem(hwindow,id_train),true);
  982.         enablewindow(getdlgitem(hwindow,id_iterstop),true);
  983.         enablemenuitem(getmenu(hwindow),cm_train,mf_bycommand or mf_enabled);
  984.         drawmenubar(hwindow);
  985.         report('Resumed');
  986.         end;
  987. end;
  988.  
  989. {----------------------------}
  990. procedure nnwindow.BNstopnet(var mess : tmessage);
  991. {----------------------------}
  992.                               { Flags the running net to stop }
  993. begin
  994.      if running or training then
  995.         begin
  996.         running   := false;
  997.         training  := false;
  998.         stopped   := true;
  999.         end
  1000. end;
  1001.  
  1002. {----------------------------}
  1003. procedure nnwindow.BNsavenet(var mess : tmessage);
  1004. {----------------------------}
  1005. begin
  1006.      CMsavefile(mess);
  1007. end;
  1008.  
  1009. {----------------------------}
  1010.       procedure nnwindow.BNreadnet(var mess : tmessage);
  1011. {----------------------------}
  1012. begin
  1013.      
  1014.      CMopenfile(mess);
  1015. end;
  1016.  
  1017. {----------------------------}
  1018.       procedure nnwindow.BNshakenet(var mess : tmessage);
  1019. {----------------------------}
  1020. begin
  1021.      if (net <> nil) then net^.shake(1.0);
  1022. end;
  1023.  
  1024. {----------------------------}
  1025. procedure nnwindow.BNtrain(var mess : tmessage);
  1026. {----------------------------}
  1027. begin
  1028.      CMTrain(mess);
  1029. end;
  1030.  
  1031.  
  1032. {----------------------------}
  1033. procedure nnwindow.showicon(state : word);
  1034. {----------------------------}
  1035.                              {Indicates the presence of a valid net}
  1036. begin
  1037.      if (state=sw_hide) or (state=sw_show) then
  1038.         showwindow(getdlgitem(hwindow,id_icon),state)
  1039. end;
  1040.  
  1041. {----------------------------}
  1042. procedure nnwindow.report(rep:pchar);
  1043. {----------------------------}
  1044. begin
  1045.      setdlgitemtext(hwindow,id_status,rep);
  1046. end;
  1047.  
  1048. {----------------------------}
  1049. procedure nnwindow.BNdataopen(var mess : tmessage);
  1050. {----------------------------}
  1051. begin
  1052.      cmdatain(mess);
  1053. end;
  1054.  
  1055. {----------------------------}
  1056. procedure nnwindow.BNdataclose(var mess : tmessage);
  1057. {----------------------------}
  1058. begin
  1059.      closedatafile;
  1060. end;
  1061.  
  1062.  
  1063. {----------------------------}
  1064. procedure nnwindow.BNlogopen(var mess : tmessage);
  1065. {----------------------------}
  1066. begin
  1067.      cmdataout(mess);
  1068. end;
  1069.  
  1070.  
  1071. {----------------------------}
  1072. procedure nnwindow.BNlogclose(var mess : tmessage);
  1073. {----------------------------}
  1074. begin
  1075.      closelogfile;
  1076. end;
  1077.  
  1078. {----------------------------}
  1079. procedure nnwindow.BNtrainparams(var mess : tmessage);
  1080. {----------------------------}
  1081. begin
  1082.      CMtrainparams(mess);
  1083. end;
  1084.  
  1085.  
  1086. {----------------------------}
  1087. procedure nnwindow.CMAbout(var mess : tmessage);
  1088. {----------------------------}
  1089. var
  1090.    dlg  : pdialog;
  1091. begin
  1092.      new(dlg,init(@self,'aboutdlg'));
  1093.      application^.execdialog(dlg);
  1094. end;
  1095.  
  1096.  
  1097.    {---------------------- SPECDIALOG PROCEDURES ------------------------}
  1098.  
  1099. {----------------------------}
  1100. procedure specdialog.zerocounts(var mess : tmessage);
  1101. {----------------------------}
  1102. var
  1103.    zero : pchar;
  1104. begin
  1105.     zero       := '0';
  1106.     senddlgitemmsg(id_netspecin, wm_settext,0,longint(zero) );
  1107.     senddlgitemmsg(id_netspecout, wm_settext,0,longint(zero) );
  1108.     senddlgitemmsg(id_netspechidden, wm_settext,0,longint(zero) );
  1109. end;
  1110.  
  1111.  
  1112.  
  1113.  
  1114.  
  1115.    {---------------------- APPLICATION PROCEDURES -----------------------}
  1116.  
  1117. {----------------------------}
  1118. procedure ANNpgm.initmainwindow;
  1119. {----------------------------}
  1120. begin
  1121.      mainwindow := new(pNNwindow,init(nil,'ALLIN'));
  1122. end;
  1123.  
  1124.  
  1125.  
  1126. {======================================== MAIN ====================================================}
  1127. var
  1128.    demo         : ANNpgm;
  1129.    space        : longint;
  1130.    temp         : array[0..20] of char;
  1131. begin
  1132.      demo.init('ANN Program 2');
  1133.      demo.run;
  1134.      demo.done;
  1135.  
  1136. end.
  1137.  
  1138. {---------------------------------------  END  -----------------------------------------------------}
  1139.